home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / spoc88 / paseng / engine.pas < prev    next >
Pascal/Delphi Source File  |  1988-07-12  |  4KB  |  143 lines
  1.   UNIT Engine;
  2.  
  3.   {$V-}
  4.  
  5.   (*********************************************************)
  6.   (*  SEARCH ENGINE                                        *)
  7.   (*     Input Parameters:                                 *)
  8.   (*       Mask : The file specification to search for     *)
  9.   (*              May contain wildcards                    *)
  10.   (*       Attr : File attribute to search for             *)
  11.   (*       Proc : Procedure to process each found file     *)
  12.   (*                                                       *)
  13.   (*     Ouput Parameters:                                 *)
  14.   (*       ErrorCode : Contains the final error code.      *)
  15.   (*                                                       *)
  16.   (*********************************************************)
  17.  
  18.   (**********************)
  19.   (**)   INTERFACE    (**)
  20.   (**********************)
  21.  
  22. USES DOS;
  23.  
  24. TYPE
  25.   ProcType    = PROCEDURE (VAR S : SearchRec; P : PathStr);
  26.   FullNameStr = STRING[12];
  27.  
  28.   PROCEDURE SearchEngine(Mask : PathStr;
  29.                           Attr : Byte;
  30.                           Proc : ProcType;
  31.                  VAR ErrorCode : Byte);
  32.  
  33.   FUNCTION GoodDirectory(S : SearchRec) : Boolean;
  34.   PROCEDURE ShrinkPath(VAR path  : PathStr);
  35.   PROCEDURE ErrorMessage(ErrCode : Byte);
  36.   PROCEDURE SearchEngineAll(path : PathStr;
  37.                             Mask : FullNameStr;
  38.                             Attr : Byte;
  39.                             Proc : ProcType;
  40.                             VAR ErrorCode : Byte);
  41.  
  42.   (**********************)
  43.   (**) IMPLEMENTATION (**)
  44.   (**********************)
  45.  
  46. VAR
  47.   EngineMask : FullNameStr;
  48.   EngineAttr : Byte;
  49.   EngineProc : ProcType;
  50.   EngineCode : Byte;
  51.  
  52.   PROCEDURE SearchEngine(Mask : PathStr;
  53.                          Attr : Byte;
  54.                          Proc : ProcType;
  55.                          VAR ErrorCode : Byte);
  56.   VAR
  57.     S : SearchRec;
  58.     P : PathStr;
  59.     Ext : ExtStr;
  60.  
  61.  
  62.   BEGIN
  63.     FSplit(Mask, P, Mask, Ext);
  64.     Mask := Mask + Ext;
  65.     FindFirst(P + Mask, Attr, S);
  66.     IF DosError <> 0 THEN
  67.       BEGIN
  68.         ErrorCode := DosError;
  69.         Exit;
  70.       END;
  71.     WHILE DosError = 0 DO
  72.       BEGIN
  73.         Proc(S, P);
  74.         FindNext(S);
  75.       END;
  76.     IF DosError = 18 THEN ErrorCode := 0
  77.     ELSE ErrorCode := DosError;
  78.   END;
  79.  
  80.   FUNCTION GoodDirectory(S : SearchRec) : Boolean;
  81.   BEGIN
  82.     GoodDirectory := (S.name <> '.') AND
  83.     (S.name <> '..') AND
  84.     (S.Attr AND Directory = Directory);
  85.   END;
  86.  
  87.   PROCEDURE ShrinkPath(VAR path : PathStr);
  88.   VAR P : Byte;
  89.     Dummy : NameStr;
  90.   BEGIN
  91.     FSplit(path, path, Dummy, Dummy);
  92.     Dec(path[0]);
  93.   END;
  94.  
  95.   {$F+} PROCEDURE SearchOneDir(VAR S : SearchRec; P : PathStr); {$F-}
  96.     {Recursive procedure to search one directory}
  97.   BEGIN
  98.     IF GoodDirectory(S) THEN
  99.       BEGIN
  100.         P := P + S.name;
  101.         SearchEngine(P + '\' + EngineMask, EngineAttr,
  102.                      EngineProc, EngineCode);
  103.         SearchEngine(P + '\*.*', Directory OR Archive,
  104.                      SearchOneDir, EngineCode);
  105.       END;
  106.   END;
  107.  
  108.   PROCEDURE SearchEngineAll(path : PathStr;
  109.                             Mask : FullNameStr;
  110.                             Attr : Byte;
  111.                             Proc : ProcType;
  112.                             VAR ErrorCode : Byte);
  113.   BEGIN
  114.     (*Set up Unit global variables for use in
  115.       recursive directory search procedure*)
  116.     EngineMask := Mask;
  117.     EngineProc := Proc;
  118.     EngineAttr := Attr;
  119.     SearchEngine(path + Mask, Attr, Proc, ErrorCode);
  120.     SearchEngine
  121.     (path + '*.*', Directory OR Attr, SearchOneDir, ErrorCode);
  122.     ErrorCode := EngineCode;
  123.   END;
  124.  
  125.   PROCEDURE ErrorMessage(ErrCode : Byte);
  126.   BEGIN
  127.     CASE ErrCode OF
  128.       0 : ;                  {OK -- no error}
  129.       2 : WriteLn('File not found');
  130.       3 : WriteLn('Path not found');
  131.       5 : WriteLn('Access denied');
  132.       6 : WriteLn('Invalid handle');
  133.       8 : WriteLn('Not enough memory');
  134.       10 : WriteLn('Invalid environment');
  135.       11 : WriteLn('Invalid format');
  136.       18 : ;                 {OK -- merely "no more files"}
  137.     ELSE WriteLn('ERROR #', ErrCode);
  138.     END;
  139.   END;
  140.  
  141.  
  142. END.
  143.